home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Gold Medal Software 2
/
Gold Medal Software Volume 2 (Gold Medal) (1994).iso
/
tutor
/
vispas.arj
/
TURTLE
< prev
next >
Wrap
Text File
|
1985-08-08
|
2KB
|
106 lines
PROGRAM TURTLE;
CONST
ON = TRUE;
OFF = FALSE;
ENDKEY = 79;
UPARROW = 72;
DNARROW = 80;
LTARROW = 75;
RTARROW = 77;
VAR
X:INTEGER;
Y:INTEGER;
ANGLE : INTEGER;
PENCOLOR : INTEGER;
KEY : INTEGER;
XSTART:INTEGER;
YSTART:INTEGER;
XEND:INTEGER;
YEND:INTEGER;
PROCEDURE DELAY;
VAR N:INTEGER;
BEGIN
FOR N := 1 TO 10 DO;
END;
PROCEDURE FINDMOVE(ANGLE:INTEGER;
VAR DX,
DY:INTEGER);
VAR
N : INTEGER;
BEGIN
N := ANGLE / 10;
CASE N OF
0: BEGIN DX := 0; DY := -100; END;
9: BEGIN DX := 100; DY := 0; END;
18:BEGIN DX := 0; DY := 100; END;
27:BEGIN DX := -100; DY := 0; END;
END;
END;
PROCEDURE FORWARD(DISTANCE:INTEGER);
VAR
DX:INTEGER;
DY:INTEGER;
BEGIN
FINDMOVE(ANGLE,DX,DY);
DX := DX*DISTANCE/100;
DY := DY*DISTANCE/100;
DRAW(X, Y, X+DX, Y+DY, PENCOLOR);
X := X + DX;
Y := Y + DY;
END;
PROCEDURE TURTLE(ON:BOOLEAN);
VAR
SAVEPC : INTEGER;
BEGIN
SAVEPC := PENCOLOR;
PENCOLOR := PENCOLOR + 128;
IF ON THEN
BEGIN
XSTART := X;
YSTART := Y;
FORWARD(5);
XEND := X;
YEND := Y;
X := XSTART;
Y := YSTART;
END ELSE
BEGIN {erase turtle}
DRAW(XSTART,YSTART,XEND,YEND,PENCOLOR);
END;
PENCOLOR := SAVEPC;
END;
BEGIN {main program}
SETMODE(4);
PENCOLOR := 3;
X := 160;
Y := 100;
ANGLE := 0;
REPEAT
REPEAT
TURTLE(ON);
DELAY;
TURTLE(OFF);
DELAY;
UNTIL KEYPRESSED; {you can't step past this line, so }
KEY := ORD(INKEY);{ Insert a stop on this line}
IF KEY MOD 256 = 0 THEN KEY := KEY/256 ELSE KEY := 0;
IF KEY IN [UPARROW,DNARROW,LTARROW,RTARROW] THEN {arrow keys}
CASE KEY OF
UPARROW: FORWARD(10);
DNARROW: FORWARD(-10);
LTARROW: IF ANGLE = 0 THEN ANGLE := 270 ELSE ANGLE := ANGLE - 90;
RTARROW: IF ANGLE = 270 THEN ANGLE := 0 ELSE ANGLE := ANGLE + 90;
END;
UNTIL KEY = ENDKEY;
END.